home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Text / Abbrev.pm next >
Encoding:
Perl POD Document  |  1999-12-28  |  1.6 KB  |  84 lines
  1. package Text::Abbrev;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. abbrev - create an abbreviation table from a list
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use Text::Abbrev;
  12.     abbrev $hashref, LIST
  13.  
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Stores all unambiguous truncations of each element of LIST
  18. as keys key in the associative array referenced to by C<$hashref>.
  19. The values are the original list elements.
  20.  
  21. =head1 EXAMPLE
  22.  
  23.     $hashref = abbrev qw(list edit send abort gripe);
  24.  
  25.     %hash = abbrev qw(list edit send abort gripe);
  26.  
  27.     abbrev $hashref, qw(list edit send abort gripe);
  28.  
  29.     abbrev(*hash, qw(list edit send abort gripe));
  30.  
  31. =cut
  32.  
  33. @ISA = qw(Exporter);
  34. @EXPORT = qw(abbrev);
  35.  
  36.  
  37. sub abbrev {
  38.     my (%domain);
  39.     my ($name, $ref, $glob);
  40.  
  41.     if (ref($_[0])) {           # hash reference preferably
  42.       $ref = shift;
  43.     } elsif ($_[0] =~ /^\*/) {  # looks like a glob (deprecated)
  44.       $glob = shift;
  45.     } 
  46.     my @cmp = @_;
  47.  
  48.     foreach $name (@_) {
  49.     my @extra = split(//,$name);
  50.     my $abbrev = shift(@extra);
  51.     my $len = 1;
  52.         my $cmp;
  53.     WORD: foreach $cmp (@cmp) {
  54.         next if $cmp eq $name;
  55.         while (substr($cmp,0,$len) eq $abbrev) {
  56.                 last WORD unless @extra;
  57.                 $abbrev .= shift(@extra);
  58.         ++$len;
  59.         }
  60.     }
  61.     $domain{$abbrev} = $name;
  62.     while (@extra) {
  63.         $abbrev .= shift(@extra);
  64.         $domain{$abbrev} = $name;
  65.     }
  66.     }
  67.     if ($ref) {
  68.       %$ref = %domain;
  69.       return;
  70.     } elsif ($glob) {           # old style
  71.       local (*hash) = $glob;
  72.       %hash = %domain;
  73.       return;
  74.     }
  75.     if (wantarray) {
  76.       %domain;
  77.     } else {
  78.       \%domain;
  79.     }
  80. }
  81.  
  82. 1;
  83.  
  84.